0 PRINT"[147]":POKE53280,9:POKE53281,7:POKE646,9
1 PRINT "               SONG MAKER":PRINT:PRINT
3 PRINT"   THIS PROGRAM LETS YOU COPY THE FR$() STRINGS FROM THE SCREEN DISPLAY";
5 PRINT" OR SAVE THE FR$() STRINGS ON DISK FOR RETRIEVAL BY SONG LOADER"
7 PRINT"   YOU TYPE IN SONGS AT 9500-9890 AND   NAME THE SONG SAVE FILE AT 200"
10 GOSUB 9000:GOTO 80
60 FOR N=1 TO LEN(MD$(PH)):SYS MM
62 F$=FR$(N,PH)
65 SYS M
66 IF DS=1 THEN GOSUB 500
67 FOR I=0 TO DU%(VAL(MID$(MD$(PH),N,1))):NEXT
68 REM SYS MM:REM STACCATO NOTES
69 NEXT:PH=PH+1:IF PH>ES% THEN PH=0
70 SYS MM:RETURN
80 PRINT "[147]SHIFT = 'PLAY NEXT PHRASE'"
81 PRINT "    Q = 'QUIT'"
82 PRINT "    S = 'SAVE SONG ON DISK'"
83 PRINT "    D = 'MAKE DATA STATEMENTS AT LINE            9400'"
84 PRINT "    P = 'PRINT EACH F$ STRING AS IT"
85 PRINT "         PLAYS; WAIT FOR KEYPRESS"
86 PRINT "         BETWEEN NOTES'"
87 PRINT "    N = 'NO PRINTING OF F$ STRINGS'"
90 DS=0
100 PRINT "                PHRASE "PH
110 IF PEEK (653)<>0 THEN GOSUB 60:GOTO 100
120 A=PEEK(203):IF A=64 THEN 110
130 IF A=62 THEN POKE 198,0:SYS 65126:REM "WARM START" ENDS PROGRAM
135 IF A=41 THEN DS=1:GOTO 110:REM SET FLAG TO PRINT FR$() VALUES
140 IF A=13 THEN PRINT "SAVING DISK FILE":GOSUB 200
145 IF A=39 THEN DS=0:REM SET FLAG TO STOP PRINTING FR$()
150 IF A=18 THEN 20000:REM MAKE DATA STATEMENTS AND WIPE OUT LINES>9400
190 GOTO 110
200 OPEN 2,8,2,"@0:SONG #1,S,W"
210 CR$=CHR$(13):PRINT#2,ES%CR$EV%CR$LD%CR$;
215 FOR I=0 TO 2:PRINT#2,G%(I)CR$;:NEXT:FOR I=0 TO 2
220 PRINT#2,AK%(I)CR$DY%(I)CR$SN%(I)CR$RE%(I)CR$;
225 FOR N=0 TO 1:PRINT#2,PW%(I,N)CR$;:NEXT:NEXT
230 FOR I=0 TO 9:PRINT#2,DU%(I)CR$;:NEXT
235 FOR PH=0 TO ES%:PRINT#2,MD$(PH)CR$;:PRINT "<";
240 FOR N=1 TO LEN(MD$(PH)):FOR I=1 TO 6
245 PRINT#2,MID$(FR$(N,PH),I,1)CR$;:NEXT:NEXT:NEXT
290 CLOSE 2:PH=0:RETURN
500 PRINT "NOTE     [157][157][157]"N:FOR I=0 TO 2:PRINT "                    ":NEXT
505 PRINT "":FOR I=1 TO 5 STEP 2
507 PRINT "               [157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]";
510 PRINT ASC(MID$(F$,I,1))"  "ASC(MID$(F$,I+1,1))"  ":NEXT
515 PRINT "PRESS SHIFT TO GO ON"
520 IF PEEK(653)=0 THEN 520
525 PRINT "[145]                     "
530 RETURN
8998 REM SET UP SOUND SHAPE
9000 F$="F":I=0:N=0:VC=0:M=848:MM=823:REM M&MM PUT ML IN CASSETTE BUFFER
9001 PH=0:ES%=8:DIM MD$(ES%),G%(2),AD(2),Y%(2)
9002 DIM ME$(ES%,2),MV$(ES%,2)
9003 REM PREVIOUS LINE:9002 DIM ME$(ES%,2),MV$(ES%,2)
9004 DIM DU%(9),PI%(168,1),AK%(2),DY%(2),SN%(2),RE%(2),WF%(2),PW%(2,1)
9008 REM ATTACK--VOICES 0,1,2
9009 REM NUMBER FROM 0 TO 15; LOWER NUMBER=SHARPER ATTACK
9010 AK%(0)=0:AK%(1)=0:AK%(2)=0
9015 FOR I=0 TO 2:AK%(I)=AK%(I)*16:NEXT
9018 REM DECAY--VOICES 0,1,2
9019 REM NUMBER FROM 0 TO 15; LOWER NUMBER=FASTER DECLINE
9020 DY%(0)=5:DY%(1)=3:DY%(2)=3
9028 REM SUSTAIN--VOICES 0,1,2
9029 REM NUMBER FROM 0 TO 15; LOWER NUMBER=SOFTER VOLUME DURING SUSTAIN
9030 SN%(0)=2:SN%(1)=0:SN%(2)=0
9035 FOR I=0 TO 2:SN%(I)=SN%(I)*16:NEXT
9038 REM RELEASE--VOICES 0,1,2
9039 REM NUMBER FROM 0 TO 15; LOWER NUMBER=FASTER DROP TO SILENCE AT END
9040 RE%(0)=0:RE%(1)=3:RE%(2)=5
9048 REM SET SOUND ADDRESSES
9050 FOR I=0 TO 2:AD(I)=54277+7*I:NEXT
9058 REM POKE ADSR ENVELOPES
9060 FOR I=0 TO 2:POKE AD(I),AK%(I) OR DY%(I)
9065 POKE AD(I)+1,SN%(I) OR RE%(I):NEXT
9067 REM SET UP GATES
9068 REM WAVEFORMS, VOICES 0,1,2 (ADD VALUES):
9069 REM TRIANGLE ON=16; SAWTOOTH ON=32; PULSE ON=64 (SET WIDTH!); NOISE ON=128
9070 WF%(0)=32:WF%(1)=64:WF%(2)=64
9075 G%(0)=WF%(0)OR 1:G%(1)=WF%(1) OR 3:G%(2)=WF%(2) OR 1
9078 REM SET PULSE WIDTHS
9079 REM VOICES 0,1,2; LOW BYTE, HIGH BYTE
9080 PW%(0,0)=200:PW%(0,1)=3
9081 PW%(1,0)=200:PW%(1,1)=10
9082 PW%(2,0)=200:PW%(2,1)=7
9085 FOR I=0 TO 2:VC=54274+I*7:FOR N=0 TO 1
9086 POKE VC+N,PW%(I,N):NEXT:NEXT
9098 REM SET UP DURATIONS
9100 FOR I=0 TO 9:READ DU%(I):NEXT
9105 DATA 40,96,128,192,256,384,512,640,768,1024
9196 REM MACHINE LANGUAGE ROUTINE (AT M)
9198 REM FIND ADDRESS OF F$ AND PUT IT IN ZERO PAGE AT 139, 140
9200 N=PEEK(45)+256*PEEK(46)+3:Y%=N/256:X%=N-Y%*256
9205 POKE M,173:POKE M+1,X%:POKE M+2,Y%:N=N+1:Y%=N/256:X%=N-Y%*256
9210 POKE M+3,133:POKE M+4,251:POKE M+5,173:POKE M+6,X%:POKE M+7,Y%
9215 POKE M+8,133:POKE M+9,252:POKE M+10,160:POKE M+11,0
9220 POKE M+12,162:POKE M+13,0
9223 REM GET EACH PITCH FROM F$ AND PUT IT IN FREQUENCY REGISTER
9225 FOR I=M+14 TO M+54 STEP 8:POKE I,177:POKE I+1,251
9230 POKE I+2,157:POKE I+3,0:POKE I+4,212
9235 POKE I+5,200:POKE I+6,162:READ A:POKE I+7,A:NEXT
9236 DATA 1,7,8,14,15,4
9238 REM GATE EACH SOUND OPEN
9240 N=0:FOR I=M+59 TO M+71 STEP 6
9241 POKE I,173:A=MM-3+N:Y%=A/256:X%=A-256*Y%:POKE I+1,X%:POKE I+2,Y%
9242 POKE I+3,141:READ A:POKE I+4,A:POKE I+5,212:N=N+1:NEXT
9243 DATA 4,11,18
9248 REM GARBAGE COLLECTION
9250 FOR I=M+77 TO M+90:READ A:POKE I,A:NEXT
9255 DATA 164,52,165,51,105,6,144,1,200,133,51,132,52,96
9258 REM GATE-OFF ML ROUTINE AT MM
9260 FOR I=MM TO MM+16 STEP 8
9261 POKE I,173:Y%=3:X%=34+(I-MM)/8:POKE I+1,X%:POKE I+2,Y%:REM USES 820-822
9262 POKE I+3,41:POKE I+4,254
9263 POKE I+5,141:READ A:POKE I+6,A:POKE I+7,212:NEXT:POKE MM+24,96
9264 DATA 4,11,18
9268 REM SET WAVEFORMS WITH GATES OFF
9269 REM STORED AT 820-822--LINE  9261 REQUIRES THIS (820=HEX 03 34)
9270 POKE 820,G%(0):POKE 821,G%(1):POKE 822,G%(2):SYS MM
9297 REM SET FILTER AND VOLUME
9298 REM FILTER FREQUENCY
9299 REM LOW BYTE (0-7) X%; HIGH BYTE (0-255) Y%
9300 X%=3:Y%=150
9305 POKE 54293,X%:POKE 54294,Y%
9308 REM FILTER ON?
9309 REM VOICE 1 ON=1; 2 ON=2; 3 ON=4; 1&2 ON=3; 2&3 ON=6; ALL ON=7
9310 X%=0
9318 REM FILTER RESONANCE
9319 REM PEAK VOLUME (0=LOW, 15=HIGH)
9320 Y%=14
9325 Y%=Y%*16:POKE 54295,X% OR Y%
9328 REM SELECT FILTER TYPE
9329 REM LOW-PASS=1;BAND-PASS=2;HIGH-PASS=4;LO-BAND=3;HI-BAND=6;ALL=7
9330 X%=1
9335 X%=X%*16
9338 REM SELECT OVERALL VOLUME
9339 REM 15=HIGH, 0=LOW
9340 Y%=15:POKE 54296,X% OR Y%
9345 EV%=2:REM SET NUMBER OF VOICES (MINUS 1)
9350 GOTO 9400
9358 REM MUSIC DATA LOADER (EFFECTIVE ONLY IF 'MAKE DATA' WAS EXECUTED
9359 REM DURING MAIN LOOP)
9360 READ ES%:READ LD%:DIM FR$(LD%,ES%)
9365 FOR PH=0 TO ES%:READ MD$(PH):FOR N=1 TO LEN(MD$(PH)):PRINT "!";
9370 FOR I=1 TO 6:READ A:FR$(N,PH)=FR$(N,PH)+CHR$(A):NEXT:NEXT:NEXT
9375 PH=0:RETURN
9397 REM SET UP PITCH ARRAY
9398 REM EACH NOTE, IN ALL ITS OCTAVES
9399 REM C
9400 X%=3:GOSUB 9490
9401 DATA 12,1,24,2,48,4,97,8,195,16,135,33,15,67,30,134
9402 REM D
9403 X%=4:GOSUB 9490
9404 DATA 45,1,90,2,180,4,104,9,209,18,162,37,69,75,139,150
9405 REM E (F-FLAT)
9406 X%=5:GOSUB 9490:Y%=13:GOSUB 9495
9407 DATA 81,1,163,2,71,5,143,10,31,21,62,42,125,84,250,168
9408 REM F (E-SHARP)
9409 X%=6:GOSUB 9490:Y%=19:GOSUB 9495
9410 DATA 102,1,204,2,152,5,48,11,96,22,193,44,131,89,6,179
9411 REM G
9412 X%=7:GOSUB 9490
9413 DATA 145,1,35,3,71,6,143,12,30,25,60,50,121,100,243,200
9414 REM A
9415 X%=1:GOSUB 9490
9416 DATA 195,1,134,3,12,7,24,14,49,28,99,56,199,112,143,225
9417 REM B
9418 X%=2:GOSUB 9490
9419 DATA 250,1,244,3,233,7,210,15,165,31,75,63,151,126,46,253
9420 REM D-FLAT (C-SHARP)
9421 X%=11:GOSUB 9490:Y%=17:GOSUB 9495
9422 DATA 28,1,56,2,112,4,225,8,195,17,134,35,12,71,24,142
9423 REM E-FLAT (D-SHARP)
9424 X%=12:GOSUB 9490:Y%=18:GOSUB 9495
9425 DATA 62,1,125,2,251,4,247,9,239,19,223,39,191,79,126,159
9426 REM G-FLAT (F-SHARP)
9427 X%=14:GOSUB 9490:Y%=20:GOSUB 9495
9428 DATA 123,1,246,2,237,5,218,11,181,23,107,47,214,94,172,189
9429 REM A-FLAT (G-SHARP)
9430 X%=8:GOSUB 9490:Y%=21:GOSUB 9495
9431 DATA 169,1,83,3,167,6,78,13,156,26,57,53,115,106,230,212
9432 REM B-FLAT (A-SHARP)
9433 X%=9:GOSUB 9490:Y%=15:GOSUB 9495
9434 DATA 221,1,187,3,119,7,239,14,223,29,190,59,124,119,248,238
9435 REM C-FLAT
9436 X%=10:GOSUB 9490
9437 DATA 4,1,250,1,244,3,233,7,210,15,165,31,75,63,151,126
9438 REM B-SHARP
9439 X%=16:GOSUB 9490
9440 DATA 24,2,48,4,97,8,195,16,135,33,15,67,30,134,255,255
9485 GOTO 9500
9489 REM READ PITCHES
9490 FOR I=0 TO 147 STEP 21:READ PI%(I+X%,0),PI%(I+X%,1):NEXT:RETURN
9494 REM IDENTICAL PITCHES
9495 FOR I=0 TO 147 STEP 21:PI%(I+Y%,0)=PI%(I+X%,0):PI%(I+Y%,1)=PI%(I+X%,1)
9496 NEXT:RETURN
9497 REM EACH PHRASE HAS ONLY ONE DU%(PH) STRING, NO MATTER HOW MANY VOICES
9498 REM EACH PHRASE HAS ONE ME$(PH,VC) & ONE MV$(PH,VC) STRING PER VOICE
9499 REM PHRASE 0
9500 MD$(0) = "100111111100111111"
9501 ME$(0,0)="FFFFGAFG@FFFFGAFGE"
9502 MV$(0,0)="6                 "
9503 ME$(0,1)="CC@DCGDCCCC@DCGDCC"
9504 MV$(0,1)="45 45354545 453545"
9505 ME$(0,2)="FA@EAGBC[191]FA@DAGBC[191]"
9506 MV$(0,2)="34 34343434 343434"
9509 REM PHRASE 1
9510 MD$(1) = "10011111111111111"
9511 ME$(1,0)="FFFFGAFGEF@@@@@@@"
9512 MV$(1,0)="6                "
9513 ME$(1,1)="FC@ECDBCCFCECDACA"
9514 MV$(1,1)="45 454  545454  5"
9515 ME$(1,2)="FA@EADBC[191]FAEADFCF"
9516 MV$(1,2)="34 34343434343435"
9519 REM PHRASE 2
9520 MD$(2) = "100111111100111111"
9521 ME$(2,0)="[191]@[191][191]CD[191]C@[191]@[191][191]CD[191]CA"
9522 MV$(2,0)="6   7 67 6   7 676"
9523 ME$(2,1)="@F@@FCGFF@F@@FCGFF"
9524 MV$(2,1)=" 5   4545     4545"
9525 ME$(2,2)="[191]D@GDCEF[177][191]D@GDCEF[177]"
9526 MV$(2,2)="35 35353535 353535"
9529 REM PHRASE 3
9530 MD$(3) = "100111111111111"
9531 ME$(3,0)="[191]@[191][191]CD[191]CA[191]@@@@@"
9532 MV$(3,0)="6   7 676      "
9533 ME$(3,1)="[191]F@AFGEFF[191]FAFGF"
9534 MV$(3,1)="45 454545454545"
9535 ME$(3,2)="[191]D@ADGCF[177][191]DADGD"
9536 MV$(3,2)="35 353535353535"
9539 REM PHRASE 4
9540 MD$(4) = "1111111111111111"
9541 ME$(4,0)="F[191]C@C@@@D[191]C@@@@@"
9542 MV$(4,0)="6 7      67     "
9543 ME$(4,1)="FFFAG[191]AADGFAG[191]AA"
9544 MV$(4,1)="45454545 4 54545"
9545 ME$(4,2)="FDFFGEAF[191]FFFGEAF"
9546 MV$(4,2)="3535353534353535"
9549 REM PHRASE 5
9550 MD$(5) = "111111111111111111"
9551 ME$(5,0)="CFG@G@@GAFG@@@@@@@"
9552 MV$(5,0)="6                 "
9553 ME$(5,1)="@BGEGFGE@BFECCAFGC"
9554 MV$(5,1)=" 4 54545 4 5453   "
9555 ME$(5,2)="@AECDBECGACFC[191]AFGF"
9556 MV$(5,2)=" 4 54  534343 2  1"
9559 REM PHRASE 6
9560 MD$(6) = "100111111100111111"
9561 ME$(6,0)="FFFFGAFG@FFFFGAFGE"
9562 MV$(6,0)="6                 "
9563 ME$(6,1)="CC@DCGDCCCC@DCGDCC"
9564 MV$(6,1)="45 45354545 453545"
9565 ME$(6,2)="FA@EAGBC[191]FA@DAGBC[191]"
9566 MV$(6,2)="34 34343434 343434"
9569 REM PHRASE 7
9570 MD$(7) = "1001111111111111"
9571 ME$(7,0)="F@FFGAFGEC@@@C@@"
9572 MV$(7,0)="6            7  "
9573 ME$(7,1)="FC@ECDBCC@A@[191]CF@"
9574 MV$(7,1)="45 454  5 4  5  "
9575 ME$(7,2)="FA@EADBC[191]FFGRA[177]@"
9576 MV$(7,2)="34 343434343435 "
9579 REM PHRASE 8
9580 MD$(8) = "111100111111111111"
9581 ME$(8,0)="DC@C@[191]AFGDF@@@F@@@"
9582 MV$(8,0)="7    6        7   "
9583 ME$(8,1)="[191]CACA@@C@CFDC[191]A@F@"
9584 MV$(8,1)="5         46 5  4 "
9585 ME$(8,2)="DCFCF@CAC[191]F[191]AGF@F@"
9586 MV$(8,2)="54535 4 3435    3 "
9898 REM SET UP CONVERSION TABLE
9900 DIM TB%(255)
9910 FOR I=0 TO 255:TB%(I)=0:NEXT
9911 FOR I=65 TO 72:TB%(I)=I-64:NEXT
9912 FOR I=193 TO 199:TB%(I)=I-178:NEXT
9913 FOR I=8 TO 14:READ A:TB%(A)=I:NEXT
9914 REM NEXT LINE SAYS: 9915 DATA 176,191,188,172,177,187,165
9915 DATA 176,191,188,172,177,187,165
9916 REM (LINE 9915 IS DELETED BY 'MAKE DATA' OPTION)
9919 REM FIND LONGEST PHRASE, AND DIM FR$ TO EXACT LENGTH NEEDED
9920 LD%=0:FOR I=0 TO ES%:X%=LEN(MD$(I)):IF X%>LD% THEN LD%=X%
9921 NEXT
9925 DIM FR$(LD%,ES%)
9928 REM CONVERT STRINGS TO USABLE FORM
9930 FOR PH=0 TO ES%:FOR N=1 TO LEN(MD$(PH)):FR$(N,PH)=""
9935 FOR VC=0 TO EV%:X%=TB%(ASC(MID$(ME$(PH,VC),N,1)))
9940 V$=MID$(MV$(PH,VC),N,1):IF V$<>" " THEN Y%(VC)=21*VAL(V$)
9945 IF X%<>0 THEN X%=X%+Y%(VC)
9950 FR$(N,PH)=FR$(N,PH)+CHR$(PI%(X%,0)):FR$(N,PH)=FR$(N,PH)+CHR$(PI%(X%,1))
9955 NEXT
9960 IF EV%<2 THEN FR$(N,PH)=FR$(N,PH)+LEFT$(FR$(N,PH),2)
9965 IF EV%<1 THEN FR$(N,PH)=FR$(N,PH)+LEFT$(FR$(N,PH),2)
9970 PRINT ".";:NEXT:NEXT
9980 PH=0
9990 RETURN
19998 REM ROUTINE TO MAKE DATA STATEMENTS THROUGH FORCED SCREEN READS
20000 PRINT "[147]MAKING DATA STATEMENTS WIPES OUT ALL THE"
20001 PRINT "LINES NOT DIRECTLY NEEDED.":PRINT:PRINT"       PROCEED? (Y OR N)"
20002 A=PEEK(203):IF (A<>39) AND (A<>25) THEN 20002
20003 IF A=39 THEN 80
20005 A=49152
20006 FOR PH=0 TO ES%:B=LEN(MD$(PH)):POKE A,B:A=A+1:PRINT ">";:FOR N=1 TO B
20007 POKE A,ASC(MID$(MD$(PH),N,1)):A=A+1:NEXT
20008 FOR N=1 TO B:FOR I=1 TO 6:POKE A,ASC(MID$(FR$(N,PH),I,1)):A=A+1
20009 NEXT:NEXT:NEXT:B=A-1:A=49152:C=9400:CR$=CHR$(13):D=4
20010 PRINT "[147]9350 REM DELETED"CR$"9390 DATA"ES%"[157],"LD%CR$;
20011 PRINT "9002 REM DELETED"CR$;
20015 GOSUB 20085:IF D>8 THEN 20091
20020 GOSUB 20080:IF D>8 THEN 20090
20025 IF A>=B THEN 20092
20030 IF N=0 THEN 20015
20035 GOTO 20020
20040 PRINT "[147]";:D=0:CR$=CHR$(13):GOTO 20025
20041 PRINT "[147]";:D=0:CR$=CHR$(13):GOTO 20020
20079 REM ROUTINE TO PRINT FR$() DATA STATEMENT ON SCREEN
20080 PRINTC"DATA";:FORI=1TO 6:PRINTPEEK(A)"[157],";:A=A+1:NEXT:C=C+1:D=D+1:N=N-1
20081 PRINT CHR$(20)CR$;:RETURN
20084 REM ROUTINE TO PRINT MD$() DATA STATEMENT ON SCREEN
20085 A$="":N=PEEK(A):A=A+1:FOR I=1 TO N:A$=A$+CHR$(PEEK(A)):A=A+1:NEXT
20086 PRINT C"DATA"CHR$(34)A$CHR$(34)CR$;:C=C+1:D=D+1:RETURN
20088 REM SET UP LAST LINE TO EXECUTE FROM SCREEN
20090 PRINT "A="A"[157]:B="B"[157]:C="C"[157]:N="N"[157]:GOTO 20040"CR$;:GOTO 20095
20091 PRINT "A="A"[157]:B="B"[157]:C="C"[157]:N="N"[157]:GOTO 20041"CR$;:GOTO 20095
20092 PRINT "C="C-1":GOTO 20100"CR$;:GOTO 20095
20094 REM LOAD KEYBOARD BUFFER WITH CARRIAGE RETURNS AND GO READ SCREEN
20095 FOR I=631 TO 640:POKE I,13:NEXT:POKE 198,10:PRINT "";:END
20100 A=PEEK(43)+256*PEEK(44):PRINT "[147]";
20105 B=PEEK(A+2)+256*PEEK(A+3):A=PEEK(A)+256*PEEK(A+1)
20106 PRINT ""A"  "B"  "C
20110 IF B=C THEN 20120
20115 GOTO 20105
20120 POKE A,0:POKE A+1,0:A=A+2
20125 B=INT(A/256):C=A-256*B
20130 PRINT "[147]150":PRINT "83"
20135 PRINT "POKE45,"C"[157]:POKE46,"B"[157]:POKE47,"C"[157]:POKE48,"B"[157]:POKE49,"C
20140 PRINT "POKE50,"B"[157]:GOTO 10"
20145 FOR I=631 TO 640:POKE I,13:NEXT:POKE 198,10:PRINT "";:END